home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / apps / 136 / applic / tinylook.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-05-12  |  12.9 KB  |  364 lines
  1. PROGRAM TINTLOOK ;    { by Steve Pauley  3/9/87 }
  2.                       { view TINY format pictures in any directory }
  3.  
  4. CONST
  5.    {$I GEMCONST.PAS}
  6.    (* ... your CONSTants ... *)
  7.  
  8. TYPE
  9.    {$I gemtype.pas}    { note that case doesn't matter }
  10.    (* ... your TYPEs ... *)
  11.    Pic_Dat = PACKED ARRAY [ 1..32034 ] of Byte;
  12.    Screen = PACKED ARRAY [ 1..32000 ] of Byte;
  13.    S_Ptr = ^Screen;     { pointer to screen data }
  14.    Path_Chars = PACKED ARRAY [ 1..80 ] OF Char ;
  15.  
  16. VAR
  17.    (* ... your VARiables ... *)
  18.    Pic_Buf      : Pic_Dat;   { a place to read picture file data into }
  19.    Scn_buf      : Screen;    { a place to stash the screen }
  20.    Scn_ptr      : S_Ptr;     { a pointer to screen }
  21.    Dat_Ptr      : Integer ;  { position of next pixil data in Pic_Buf array }
  22.    Scn_Buf_Ptr  : Integer ;  { position of next pixil data in Scn_Buf array }
  23.    Starting_Rez : Integer ;  { resolution program was run from }
  24.    Pic_Rez      : Integer ;  { store picture resolution value }
  25.    Kolor_Reg         : ARRAY[ 0..15 ] OF Integer;  { stores color registers }
  26.    Starting_Kolor_Reg: ARRAY[ 0..15 ] OF Integer;  { stores color registers }
  27.    X_Screen     : Long_Integer ; { screen location return from xbios call }
  28.    More         : Boolean ;  { if true show another picture }
  29.    Valid_Name   : Boolean;   { flag for valid file name extender }
  30.    F_Name, P_Name : Path_Name ;  { file an path names for gem dialoge box }
  31.  
  32.    {$I gemsubs}          { and that ".PAS" is default }
  33.  
  34. FUNCTION Logical_Screen : Long_Integer;
  35.   XBIOS($3);
  36.  
  37. FUNCTION Screen_Rez : integer;
  38.   XBIOS($4);
  39.  
  40. PROCEDURE Set_Screen( Log_Scn, Phy_Scn : Long_Integer ; Rez : Integer );
  41.    XBIOS($5);
  42.  
  43. FUNCTION Set_Col( AI,BI : Integer ): Integer ; {read and set color reg.}
  44.    XBIOS( 7 );
  45.  
  46. PROCEDURE Save_Kolors; { saves color values into globle array Kolor_Reg }
  47. VAR  I  :Integer;
  48. BEGIN
  49.    FOR I := 0 TO 15 DO  Kolor_Reg[ I ] := Set_Col( I, -1 );
  50. END; { of Save_Kolors }
  51.  
  52. PROCEDURE Restore_Kolors; { restores color values from globle array Kolor_Reg }
  53. VAR  I, Junk  :Integer;
  54. BEGIN
  55.    FOR I := 0 TO 15 DO  Junk := Set_Col( I, ( Kolor_Reg[ I ] ) );
  56. END; { of Restore_Kolors }
  57.  
  58. PROCEDURE Make_Path( VAR ps : Path_Name ; VAR cs : Path_Chars ) ;
  59. VAR
  60.    i : Integer ;
  61. BEGIN
  62.    FOR i := 1 TO Length( ps ) DO
  63.    BEGIN
  64.       cs[i] := ps[i] ;
  65.    END ;
  66.       cs[ length(ps)+1 ] := Chr(0) ;
  67. END;
  68.  
  69. { Open an existing file. }
  70. FUNCTION f_open( VAR name : Path_Chars ; mode : Integer ) : Integer ;
  71.   GEMDOS( $3d ) ;
  72. { Mode - 0=read only, 1=write only, 2=reading and writing }
  73.  
  74. { Close an open file. }
  75. FUNCTION f_close( handle : Integer ) : Integer ;
  76.   GEMDOS( $3e ) ;
  77.  
  78. { Read bytes from a file. }
  79. FUNCTION f_read( handle : Integer ; count : Long_Integer ; VAR buf : Pic_Dat
  80. ) : Long_Integer ;
  81.   GEMDOS( $3f ) ;
  82.  
  83. FUNCTION Physbase : S_Ptr;    { xbios routine returns address of screen }
  84.   Xbios( 2 );
  85.  
  86. PROCEDURE Sav_scn;              { proc saves screen to buf }
  87. {$P-}           { turn pointer checking off }
  88.    begin
  89.       Scn_ptr := Physbase;      { get addr of screen in memory }
  90.       Scn_buf := Scn_Ptr^;      { do assignment, copy entire array }
  91.    end;
  92. {$P=}           { restore pointer checking to old state }
  93.  
  94. PROCEDURE Rest_scn;             { restore screen from buf }
  95. {$P-}           { turn pointer checking off }
  96.    begin
  97.       Scn_ptr := Physbase;      { get addr of screen in memory }
  98.       Scn_ptr^ := Scn_buf;      { assign, copy array }
  99.    end;
  100. {$P=}           { set pointer checking to old state }
  101.  
  102.  
  103. PROCEDURE Ask_For_Name;
  104. VAR
  105.    A1,A2,Alert          : Str255 ;
  106.    junk,IO_Error        : Integer ;
  107.    I                    : Integer;       { temporary variable }
  108.    Times                : Integer;       { compression counter }
  109.    Stuff                : FILE OF Integer;{ file type binder }
  110.    P_New,P_Mark         : Integer;       { x counter for looking at array }
  111.    Temp,L_Data          : Byte;          { array data }
  112. BEGIN
  113.    Valid_Name := False ;
  114.    Show_Mouse ;
  115.    More := Get_In_File( P_Name,F_Name ) ;
  116.    Hide_Mouse ;
  117.    Paint_Rect( 0, 0, 640, 200 ); { erase screen }
  118.    Show_Mouse ;
  119.    IF More THEN
  120.    BEGIN
  121.       I := Pos('.',F_Name);
  122.       IF F_Name[ I+1 ] = 'T' THEN
  123.       BEGIN
  124.          IF F_Name[ I+2 ] = 'N' THEN
  125.          BEGIN
  126.             IF F_Name[ I+3 ] = 'Y' THEN
  127.             BEGIN
  128.                Valid_Name := True;
  129.             END;
  130.          END;
  131.       END;
  132.       IF NOT Valid_Name THEN
  133.       BEGIN
  134.          Alert :='';
  135.          A1 := 'The file name you|picked was not|legal. Use the|extender' ;
  136.          A2 := ' .TNY only.' ;
  137.          Alert :=  concat( '[3][',A1,A2,'][ OOPS! ]' );
  138.          junk := Do_Alert( Alert, 0 ) ;
  139.       END;
  140.    END;
  141.    Hide_Mouse ;
  142. END;  { of Ask_For_Name }
  143.  
  144.  
  145. PROCEDURE S_Load;
  146. VAR
  147.    A1, A2, Alert        : Str255 ;
  148.    junk, IO_Handle      : Integer ;
  149.    I, K                 : Integer;       { temporary variable }
  150.    K_Byte               : Byte ;
  151.    Temp                 : Long_Integer;       { one disk file value }
  152.    Name                 : Path_Chars ;
  153. BEGIN
  154.    Make_Path( F_Name, Name );
  155.    IO_Handle := F_Open( Name,2 ) ;
  156.    IF IO_Handle >= 0 THEN
  157.    BEGIN
  158.       Temp := F_Read( IO_Handle,32034,Pic_Buf) ;
  159.    END
  160.    ELSE BEGIN
  161.       Alert :='';
  162.       A1 := 'I could not load a|screen by that|name. I will return|' ;
  163.       A2 := 'you to your desktop.' ;
  164.       Alert :=  concat( '[2][',A1,A2,'][ *NUTS* ]' );
  165.       Junk := Do_Alert( Alert, 0 ) ;
  166.    END;
  167.    Junk := F_Close( IO_Handle ) ;
  168. END;  { of S_Load }
  169.  
  170. PROCEDURE U_Copy( Count : Integer ) ;
  171. VAR
  172.    I, J            : Integer ;
  173. BEGIN
  174.    I := 0 ;
  175.    REPEAT
  176.       J := SHL( I,1 ) ;
  177.       Scn_Buf[ Scn_Buf_Ptr ] := Pic_Buf[ Dat_Ptr + J ] ;
  178.       Scn_Buf[ Scn_Buf_Ptr + 1 ] := Pic_Buf[ Dat_Ptr + J + 1 ] ;
  179.       Scn_Buf_Ptr := Scn_Buf_Ptr + 160 ;
  180.       IF Scn_Buf_Ptr > 32000 THEN
  181.       BEGIN
  182.          Scn_Buf_Ptr := Scn_Buf_Ptr - 31992 ;
  183.          IF Scn_Buf_Ptr > 160 THEN Scn_Buf_Ptr := Scn_Buf_Ptr - 158 ;
  184.       END;
  185.       I := I + 1 ;
  186.    UNTIL I = (Count) ;
  187. END;  { of U_Copy }
  188.  
  189. PROCEDURE Rep_Copy( Count : Integer ) ;
  190. VAR
  191.    I            : Integer ;
  192. BEGIN
  193.    FOR I := 1 TO Count DO
  194.    BEGIN
  195.       Scn_Buf[ Scn_Buf_Ptr ] := Pic_Buf[ Dat_Ptr ] ;
  196.       Scn_Buf[ Scn_Buf_Ptr + 1 ] := Pic_Buf[ Dat_Ptr + 1 ] ;
  197.       Scn_Buf_Ptr := Scn_Buf_Ptr + 160 ;
  198.       IF Scn_Buf_Ptr > 32000 THEN
  199.       BEGIN
  200.          Scn_Buf_Ptr := Scn_Buf_Ptr - 31992 ;
  201.          IF Scn_Buf_Ptr > 160 THEN Scn_Buf_Ptr := Scn_Buf_Ptr - 158 ;
  202.       END;
  203.    END;
  204. END;  { of Rep_Copy }
  205.  
  206.  
  207. PROCEDURE Un_Tiny ;
  208. { this procedure works with the globle variable - Pic_Buf - which contains the
  209.   raw tiny fomat file data read from a disk file. this procedure un-compacts
  210.   data in this file and stores in the globle variable - Scn_Buf - which then
  211.   can be move to screen memory with the procedure Rest_Scn. }
  212. { this procedure also makes calls to U_Copy and Rep_Copy    }
  213.   { Pic_Buf     a place to read picture file data into }
  214.   { Scn_buf     a place to stash the screen }
  215.  
  216. VAR
  217.    Junk         : Integer ;    { for trow away data return by function call }
  218.    I, J, K      : Integer ;    { loop and temp color data }
  219.    Ctl_Cnt      : Integer;     { # of control data bytes }
  220.    Dat_Cnt      : Integer;     { # of pixil data bytes }
  221.    Ctl_Ptr      : Integer ;    { position of next control data }
  222.    Ctl_End      : Integer ;    { end position of control data }
  223.    Dat_End      : Integer ;    { end position of pixil data }
  224.    Temp_Rez     : Byte ;       { read first data value into this variable }
  225.    Temp_Ptr     : Integer ;    { pionter into Pic_Buf }
  226.    Rep_Cnt      : Integer ;    { counter for repeat of pixil data }
  227.    U_Cnt        : Integer ;    { counter for Unique pixil data }
  228. BEGIN
  229.    Scn_Buf_Ptr := 1 ;
  230.    Temp_Rez := Pic_Buf[ 1 ] ;
  231.    { calculate picture file resolution and and if rotation data bytes }
  232.    IF Temp_Rez > 2 THEN Pic_Rez := Temp_Rez - 3 ELSE Pic_Rez := Temp_Rez ;
  233.    If ( Pic_Rez = 0 ) OR ( Pic_Rez = 1 ) THEN  { low or med resolution }
  234.    BEGIN
  235.       IF Temp_Rez > 2 THEN    { find where color data is and copy }
  236.       BEGIN
  237.          FOR I := 0 TO 15 DO
  238.          BEGIN
  239.             K := SHL( Pic_Buf[ (SHL(I,1)+6) ],8 ) ; { get color data }
  240.             Kolor_Reg[ I ] := K + ( Pic_Buf[ (SHL(I,1)+7) ] ) ;
  241.          END;
  242.       END ELSE
  243.       BEGIN
  244.          FOR I := 0 TO 15 DO
  245.          BEGIN
  246.             K := SHL( Pic_Buf[ (SHL(I,1)+2) ],8 ) ; { get color data }
  247.             Kolor_Reg[ I ] := K + ( Pic_Buf[ (SHL(I,1)+3) ] ) ;
  248.          END;
  249.       END;
  250.       Temp_Ptr := 34 ; { piont to ctl_cnt data in Pic_Buf array }
  251.       IF Temp_Rez > 2 THEN Temp_Ptr := 38 ;
  252.          { find number of control bytes }
  253.       Ctl_Cnt := SHL( Pic_Buf[ Temp_Ptr ],8 ) + Pic_Buf[ Temp_Ptr + 1 ] ;
  254.          { find number of pixil data bytes * 2 }
  255.       Dat_Cnt := SHL( Pic_Buf[ Temp_Ptr + 2 ],8 ) + Pic_Buf[ Temp_Ptr + 3 ] ;
  256.          { set control pointer to start of control and pixil data in array }
  257.       Ctl_Ptr := Temp_Ptr + 4 ;
  258.       Dat_Ptr := Ctl_Ptr + Ctl_Cnt ;
  259.          { find end of the 2 data groups, control and pixil }
  260.       Ctl_End := Ctl_Ptr + Ctl_Cnt - 1 ;
  261.       Dat_End := SHL( Dat_Cnt,1 ) + Ctl_End ;
  262.  
  263.       REPEAT
  264.  
  265.          { if control byte is 0 then repeat data times next 2 control bytes }
  266.       IF Pic_Buf[ Ctl_Ptr ] = 0 THEN
  267.       BEGIN
  268.          Temp_Ptr := Ctl_Ptr + 3 ; { find next Ctl_Ptr for next time through }
  269.             { clculate number of repeats }
  270.          Rep_Cnt :=(SHL(Pic_Buf[(Ctl_Ptr+1)],8 ))+( Pic_Buf[(Ctl_Ptr+2)]) ;
  271.          Rep_Copy( Rep_Cnt ) ;
  272.          Dat_Ptr := Dat_Ptr + 2 ;
  273.       END ;
  274.  
  275.          { if control byte is 1<btye<128 then repeat data that many times }
  276.       IF ( Pic_Buf[ Ctl_Ptr ] > 1 ) AND ( Pic_Buf[ Ctl_Ptr ] < 128 ) THEN
  277.       BEGIN
  278.          Temp_Ptr := Ctl_Ptr + 1 ; { find next Ctl_Ptr for next time through }
  279.          Rep_Cnt := Pic_Buf[ Ctl_Ptr ] ;
  280.          Rep_Copy( Rep_Cnt ) ;
  281.          Dat_Ptr := Dat_Ptr + 2 ;
  282.       END;
  283.  
  284.          { If control byte is = 1 then copy consecutive unique data bytes }
  285.       IF Pic_Buf[ Ctl_Ptr ] = 1 THEN
  286.       BEGIN
  287.          Temp_Ptr := Ctl_Ptr + 3 ; { find next Ctl_Ptr for next time through }
  288.             { clculate number of unique bytes }
  289.          U_Cnt :=(SHL(Pic_Buf[(Ctl_Ptr+1)],8))+( Pic_Buf[(Ctl_Ptr+2)]) ;
  290.          U_Copy( U_Cnt ) ;
  291.          Dat_Ptr := Dat_Ptr + U_Cnt * 2 ;
  292.       END;
  293.  
  294.          { if control byte is > 127 copy that many unique data bytes }
  295.       IF ( Pic_Buf[ Ctl_Ptr ] > 127 ) THEN
  296.       BEGIN
  297.          Temp_Ptr := Ctl_Ptr + 1 ; { find next Ctl_Ptr for next time through }
  298.             { clculate number of unique bytes }
  299.          U_Cnt := ( 256 - Pic_Buf[ Ctl_Ptr ] ) ; { make byte positive }
  300.          U_Copy( U_Cnt ) ;
  301.          Dat_Ptr := Dat_Ptr + (SHL(U_Cnt,1)) ;
  302.       END;
  303.       Ctl_Ptr := Temp_Ptr ;
  304.  
  305.       UNTIL ( Ctl_Ptr > Ctl_End ) OR ( Dat_Ptr > Dat_End ) ;
  306.    END;
  307. END;  { of Un_Tiny }
  308.  
  309. PROCEDURE Event_Loop ;
  310. VAR
  311.    which,
  312.    dummy,
  313.    key_state, W_key,
  314.    x, y : integer ;
  315.    msg : Message_Buffer ;
  316. BEGIN
  317.    REPEAT
  318.      { Get a mouse button event. }
  319.      which := Get_Event( E_Timer | E_Button, $0001, 0, 0,
  320.               0, { time count of zero - quik return }
  321.               false, 0, 0, 0, 0, false, 0, 0, 0, 0, { no rect's }
  322.               msg, W_Key,   { what key }
  323.               dummy, dummy, x, y, key_state ) ;
  324.    UNTIL which<34;
  325. END ;  { of Event_Loop }
  326.  
  327.  
  328.   BEGIN
  329.     IF Init_Gem >= 0 THEN
  330.       BEGIN
  331.         Hide_Mouse;
  332.         P_Name := 'A:\*.TNY';
  333.         F_Name := '' ;
  334.         Paint_Color( 3 );
  335.         Text_Color( 0 );
  336.         Starting_Rez := Screen_Rez ; { gets rez that program was run from }
  337.         X_Screen := Logical_Screen;  { gets visible/logical screen address }
  338.         Save_Kolors ;                { reads color registers }
  339.         Starting_Kolor_Reg := Kolor_Reg ; { back-up of starting colors }
  340.         REPEAT
  341.         Draw_Mode( 1 ) ;
  342.         Paint_Rect( 0, 0, 640, 200 ); { erase screen }
  343.         Draw_Mode( 2 ) ;
  344.         Draw_String( 90,16,
  345.            '** TINYLOOK **  by Steve Pauley with help from Todd Burkey' );
  346.         Ask_For_Name ;               { get file nam e to load }
  347.         IF Valid_Name THEN           { if it had .TNY as an extender }
  348.         BEGIN
  349.            S_Load;                   { load raw data in buffer }
  350.            Un_Tiny ;                 { uncompress data and store in buffer }
  351.            Set_Screen( X_Screen, X_Screen, Pic_Rez ); { change to picture rez }
  352.            Restore_Kolors ;          { sets new picture colors }
  353.            Rest_Scn;                 { move picture buffer to visible screen }
  354.            Event_Loop ;              { wait for left mouse button event }
  355.            Set_Screen( X_Screen, X_Screen, Starting_Rez ); { restore rez }
  356.            Kolor_Reg := Starting_Kolor_Reg ;
  357.            Restore_Kolors ;          { restore desk top kolors }
  358.         END;
  359.         UNTIL NOT More ;  { if cancel was selected stop program }
  360.         Show_Mouse;
  361.         Exit_Gem ;
  362.       END ;
  363.   END.
  364.